00010	BEGIN "EXTEND"
00020	DEFINE ⊂="COMMENT";  ⊂ 9/2/73 EXTENDS INPUT  DATA;
00030	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040	DEFINE ARRSIZ="128",FRIMAX="ARRSIZ*6",PITMAX="ARRSIZ";
00050	
00060	INTEGER ARRAY INDATA[0:255];
00070	INTEGER ARRAY LFILE[0:'177];
00080	INTEGER ARRAY FRIDAT,PITDAT[0:ARRSIZ-1];
00090	INTEGER FRICNT,PITCNT,POINTF,POINTP,PITLOC,PITVAL;
00100	INTEGER ARRAY SUMS[0:23,0:63];
00110	INTEGER I,J,K,L,M,N,P,SEGC,SEGTOT,BRK,EOF,EOFA,BPT,RL,EOF4,EOF5,EOF6;
00120	INTEGER CHAN1,CHAN2, CHAN3,CHAN4,CHAN5,CHAN6;
00130	STRING READ1,READ2,READ3,FILEI,FILEL,FILLST;
00140	BOOLEAN ER;
00150	
00160	INTEGER PROCEDURE FRICAT;
00170	BEGIN
00180	INTEGER I,J;
00190	IF FRICNT≥FRIMAX THEN BEGIN
00200	  FOR I←0 STEP 1 UNTIL ARRSIZ-1 DO FRIDAT[I]←0;
00210	  IF EOF5=0 THEN ARRYIN(CHAN5,FRIDAT[0],ARRSIZ);
00220	  POINTF←POINT(6,FRIDAT[0],-1);
00230	  FRICNT←0; END;
00240	FRICNT←FRICNT+1;
00250	J←ILDB(POINTF);
00260	RETURN(J);
00270	END;
00280	
00290	INTEGER PROCEDURE PITCH;
00300	BEGIN
00310	INTEGER I,J;
00340	  IF PITCNT≥PITMAX THEN BEGIN
00350	    FOR I←0 STEP 1 UNTIL ARRSIZ-1 DO PITDAT[I]←0;
00360	    IF EOF6=0 THEN ARRYIN(CHAN6,PITDAT[0],ARRSIZ);
00370	    POINTP←POINT(6,PITDAT[0],-1);
00380	    PITCNT←0; END;
00400	  PITCNT←PITCNT+1;
00410	  PITVAL←ILDB(POINTP);
00420	IF PITLOC≤(SEGC+2)*128 THEN RETURN(PITVAL) ELSE RETURN(EOF6);
00430	END;
00440	
     

00010	STDBRK(1);
00020	SETBREAK(14,"∃",NULL,"INS");
00030	SETBREAK(16,'56,NULL,"INA");
00040	
00050	OUTSTR("This program extends the input data from the specified file "
00060	&CRLF&"and creates a new file with extension of T0X."&CRLF);
00070	OUTSTR("It uses data as to frication and glottal energy obtained from"
00080	  &CRLF&" files with the same name but with extensions .FRI AND .PIT."&CRLF);
00090	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00100	
00110	OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00120	LOOKUP(CHAN1,"NORMAL.DAT",0);
00130	ARRYIN(CHAN1,SUMS[0,0],1536);
00140	CLOSE(CHAN1);
00150	
00160	OUTSTR(CRLF&"Data file list (LIST28) = "); FILEL←INCHWL;
00170	IF FILEL="" THEN FILEL←"LIST28";
00180	CLOSE(CHAN2); OPEN(CHAN2,"DSK",1,2,0,3500,BRK,EOFA);
00190	LOOKUP(CHAN2,FILEL,ER);
00200	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&" File = ");
00210	LOOKUP(CHAN2,FILEL←INCHWL,ER); END;  EOFA←0;
00220	FILLST←INPUT(CHAN2,14); EOFA←0; RL←0; CLOSE(CHAN2);
00230	WHILE EOFA=0 DO BEGIN "LISTREAD"
00240	FILEI←SCAN(FILLST,1,J); IF FILEI="" THEN DONE;
00250	
00260	CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF4);
00270	LOOKUP(CHAN4,FILEI,ER);
00290	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00300	SEGTOT←(LFILE[0]*6)%256;  SEGC←0;
00310	OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
00320	
00330	READ1←SCAN(FILEI,16,J)&"T0X";
00340	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,10,0,0,EOF);
00350	ENTER(CHAN3,READ1,BRK); ARRYOUT(CHAN3,LFILE[0],'200);
00360	
00370	READ3←READ1;
00380	READ2←SCAN(READ3,16,J)&"FRI";
00390	OUTSTR(READ2&CRLF);
00400	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,10,0,0,0,EOF5);
00410	LOOKUP(CHAN5,READ2,BRK);
00420	
00430	READ3←READ2;
00440	READ3←SCAN(READ3,16,J)&"PIX";
00450	CLOSE(CHAN6); OPEN(CHAN6,"DSK",'10,10,0,0,0,EOF6);
00460	LOOKUP(CHAN6,READ3,BRK);
00470	FRICNT←PITCNT←99999; PITLOC←PITVAL←0;
00480	
00490	WHILE TRUE DO BEGIN
00500	  IF EOF4≠0 THEN DONE;
00510	  FOR I←0 STEP 1 UNTIL 255 DO INDATA[I]←0;
00520	  ARRYIN(CHAN4,INDATA[0],256);
00530	  BPT←POINT(6,INDATA[0],-1);
00540	  FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00550	    SEGC←SEGC+1; IF SEGC>SEGTOT THEN DONE;
00560	    FOR P←0 STEP 1 UNTIL 15 DO IBP(BPT);
00570	    K←ILDB(BPT); L←ILDB(BPT); M←ILDB(BPT);
00580	    K←(K LSH 6)%(L+56); M←(M LSH 6)%(L+16);
00590	    IF K>63 THEN K←63; IF M>63 THEN M←63;
00600	    IDPB(K,BPT); IDPB(M,BPT);
00610	    J←FRICAT; ⊂ OUTSTR("Fricat= "&CVOS(J)&TB);
00620	    IDPB(J,BPT); IDPB(PITCH,BPT); IBP(BPT);
00630	    END;
00640	  ARRYOUT(CHAN3,INDATA[0],256);
00650	  IF SEGC>SEGTOT THEN DONE;
00660	  END;
00670	
00680	CLOSE(CHAN3); OUTSTR(" Created file "&READ1&CRLF); 
00690	
00700	IF EOFA≠0 THEN DONE;
00710	END "LISTREAD";
00720	
00730	
00740	RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3); RELEASE(CHAN4);
00750	
00760	END "EXTEND";